perm filename CONVRT.FAI[IRC,LCS] blob
sn#273060 filedate 1977-03-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 COMMENT Character string conversion package
C00008 00003 ENTRY RDIOSP ↔ TITLE RDIOSP ↔EXTERNAL RDSIX
C00012 00004 ENTRY WRIOSP ↔ TITLE WRIOSP ↔EXTERNAL WRSIX
C00014 00005 ENTRY RDFILN ↔ TITLE RDFILN ↔EXTERNAL RDSIX
C00018 00006 ENTRY WRFILN ↔ TITLE WRFILN ↔EXTERNAL WRSIX
C00020 00007 ENTRY RDINT ↔ TITLE RDINT
C00021 00008 ENTRY WRINT ↔ TITLE WRINT
C00023 00009 ENTRY WROCT ↔ TITLE WROCT
C00024 00010 ENTRY WREFLO,WRFFLO,WRFLO ↔ TITLE WRFLO
C00035 00011 ENTRY RDSIX ↔ TITLE RDSIX
C00037 00012 ENTRY WRSIX ↔ TITLE WRSIX
C00038 00013 ENTRY WRASCZ ↔ TITLE WRASCZ
C00039 00014 ENTRY WRSQUO ↔ TITLE CVSQUO
C00041 00015 ENTRY WRDATE,WRTIME,WRTIMT,WRDAYT↔ TITLE WRDATE
C00045 00016 ENTRY POP1J.,POP2J.,POP3J.,POP4J.↔ TITLE POPJS
C00046 ENDMK
C⊗;
COMMENT ⊗ Character string conversion package
This package is a collection of frequently used conversion
subroutines, such as convert integer to character stream and convert
character stream to sixbit. The character stream source or
destination are defined by a PDP-10 instruction, such as
PUSHJ P,GETCHR. All character stream destinations are expected to
return a character in accumulator 1 and all character stream
destination are expected to recieve its character in accumulator 1.
Subroutines which return arguments always return their arguments in
accumulator 1 and if a break character is to be return, it will be
in accumulator 0. Character streams should not modify any other
accumulators. These subroutines are:
RDINT(Integer BASE; Character_source OPCODE);
Convert character stream into integer, in specified base.
WRINT(Integer N, BASE; Character_destination OPCODE);
Convert integer into character stream, in specified base.
RDSIX(Integer SIXBIT; Character_source OPCODE, Breaktable BRKTAB);
Convert sixbit word into character stream.
WRSIX(Integer SIXBIT; Character_destination OPCODE);
Convert sixbit word into character stream.
RDFLO(Operation OPCODE);
Convert character stream into real, in specified base. (UNIMPLIMENTED)
WREFLO(Real N,CHARACTER_COUNT,CONTROL_WORD; Character_destination
OPCODE);
Convert floating point number into character stream of specified
format. CONTROL_WORD is of form. (See FORTRAN for details on this
format).
XWD <characters to left of decimal point>,<width of field>
RDFILN(Array FILBLK; Character_source OPCODE; Sixbit
DEFAULT_EXTENSION)
Convert a character string into system file name structure.
WRFILN(Array FILBLK; Character_destination OPCODE)
Convert system file name structure into a character stream.
RDIOSP(Array FILBLK; Character_source OPCODE; Sixbit
DEFAULT_EXTENSION)
Convert a character string into system device and file name structure.
WRIOSP(Array FILBLK; Character_destination OPCODE)
Convert system device and file name structure into a character stream.
WRASCZ(Ascizstring S; Character_destination OPCODE)
Converts an ASCIZ string into a character stream
WRDATE(Character_destination OPCODE)
Converts current date into a character stream.
A break table is the standard system format four word table
representing which characters are break characters. See UUO Manual
for details. Briefly,
Word 0 contains bits for <null> thru #,
Word 1 contains bits for $ thru G,
Word 2 contains bits for H thru k
Word 3 contains bits for l thru <bs>
Note: LIBRARY.TMP should be a copy of either HEADER.FAI or EXPHD.FAI
⊗;
ENTRY RDIOSP ↔ TITLE RDIOSP ↔EXTERNAL RDSIX
.INSERT LIBRARY.TMP
IFE STANSW,<
EXTERNAL RDINT
>
;____________________________________________________________________
NSUBR RDIOSP,DEVBLK,OPCODE,DEFEXT
; Read a device name and file name into DEVBLK, returning terminator
; in AC 0 and AC 1. Default extension is used if none is given.
; Skip return if successful. If no device or file is given, do not
; alter DEVBLK and non-skip return
;DEVBLK: SIXBIT/DEVNAM/
; XWD OUTPTR,INPTR
; SIXBIT/FILNAM/
; SIXBIT/EXT/
; 0
; SIXBIT/PRJPRG/
ACCUMULATORS{P1}
PUSHP P1
MOVE P1,DEVBLK
MOVSI 1,'DSK'
MOVEM 1,(P1)
CALL RDFIL1 ;Read SIXBIT
JUMPE 1,RET
CAIE 0,":"
JRST NODEV
MOVEM 1,(P1) ;Set device name
CALL RDFIL1
NODEV: MOVEM 1,2(P1)
HLLZ 1,DEFEXT ;Fetch default extension
MOVEM 1,3(P1)
SETZ 1,
IFE STANSW, < GETPPN 1, > ;STANFORD alias kiudge
IFN STANSW, < DSKPPN 1, > ;Default PPN is self
MOVEM 1,5(P1)
CAIE 0,"." ;Extension coming?
GO NOTEXT
CALL RDFIL1 ;Yes, read it
HLLZM 1,3(P1)
NOTEXT: CAIE 0,"[" ;PPN coming?
GO SKRET ;No, return
IFN STANSW, < CALL RDFIL1 ;Read project
CALL RJUST
HLLM 1,5(P1) > ;(Stanford likes it PPN's right justified)
IFE STANSW, < CALL(RDINT,[8],OPCODE) ;DEC likes octal
HRLM 1,5(P1) >
CAIE 0,","
GO NOTCOM ;Assume he wants same programmer area
IFN STANSW, < CALL RDFIL1 ;Read programmer
CALL RJUST ;(Stanford likes it PPN's right justified)
HLRM 1,5(P1) >
IFE STANSW, < CALL(RDINT,[8],OPCODE) ;DEC likes octal
HRRM 1,5(P1) >
NOTCOM: CAIE 0,"]" ;Don't worry if no ']'
GO SKRET
XCT OPCODE
MOVE 0,1
;Skip return
SKRET: AOS -1(P)
;Non-skip return
RET: MOVE 1,0
POPP P1
POP3J
.PLEVEL←←.PLEVEL+2 ;(Set stack level for subr)
;Read sixbit with appropriate break characters
RDFIL1: CALL(RDSIX,OPCODE,[FILBRK])
POP0J
;Right justify for Stanford PPN
IFN STANSW,
<RJUST: JUMPE 1,[ POP0J ]
RJUST2: TLNE 1,77
POP0J
LSH 1,-6
GO RJUST2 >
.PLEVEL←←.PLEVEL-2
; The break table, break on not A-Z,a-z or $%
FILBRK: BYTE (32) -1 (1) 0 (3) -1 ;<null> thru #
BYTE (2) 0 (10) -1 (10) 0 (6) -1 (1) -1 (7) 0 ;$ thru G
BYTE (19) 0 (5) -1 (1) -1 (11) 0 ;H thru k
BYTE (15) 0 (5) -1 (16) 0 ;l thru <bs>
SUBREND RDIOSP
PRGEND
ENTRY WRIOSP ↔ TITLE WRIOSP ↔EXTERNAL WRSIX
.INSERT LIBRARY.TMP
IFE STANSW,< EXTERNAL WRINT >
;____________________________________________________________________
NSUBR WRIOSP,DEVBLK,OPCODE
ACCUMULATORS{P1,P2}
PUSHP P1
EXCH P2,DEVBLK
MOVSI P1,(<POINT 6,(P2)>)
LOOP1: ILDB 1,P1
JUMPE 1,CONT1
ADDI 1,40
XCT OPCODE
CONT1: CAMN P1,[POINT 6,(P2),35]
GO [ ADDI P1,1
MOVEI 1,":"
XCT OPCODE
GO LOOP1 ]
CAMN P1,[POINT 6,2(P2),35]
GO [ HLLZ 1,3(P2)
JUMPN 1,[ MOVEI 1,"."
XCT OPCODE
GO .+1 ]
GO EXTDON ]
CAME P1,[POINT 6,3(P2),17]
GO LOOP1
EXTDON: SKIPN 5(P2)
GO PPNDON
MOVEI 1,"["
XCT OPCODE
IFN STANSW,<
MOVE P1,[POINT 6,5(P2)]
LOOP2: ILDB 1,P1
JUMPE 1,CONT2
ADDI 1,40
XCT OPCODE
CONT2: CAMN P1,[POINT 6,5(P2),17]
GO [ MOVEI 1,","
XCT OPCODE
GO LOOP2 ]
CAME P1,[POINT 6,5(P2),35]
GO LOOP2
>;IFN STANSW
IFE STANSW,<
HLRZ 0,5(P2)
CALL(WRINT,0,[8],OPCODE)
MOVEI 1,","
XCT OPCODE
HRRZ 0,5(P2)
CALL(WRINT,0,[8],OPCODE)
>;IFE STANSW
MOVEI 1,"]"
XCT OPCODE
PPNDON: EXCH P2,DEVBLK
POPP P1
POP2J
SUBREND WRIOSP
;____________________________________________________________________
PRGEND
ENTRY RDFILN ↔ TITLE RDFILN ↔EXTERNAL RDSIX
.INSERT LIBRARY.TMP
IFE STANSW,< EXTERNAL RDINT >
;____________________________________________________________________
NSUBR RDFILN,FILBLK,OPCODE,DEFEXT
; Read a file name into FILBLK, returning terminator in AC 0 and AC 1.
; Default extension is used if none is given.
; Skip return if successful. If no file is given, do not alter
; FILBLK and non-skip return.
ACCUMULATORS{P1}
PUSHP P1
MOVE P1,FILBLK
CALL RDFIL1 ;Read SIXBIT
JUMPE 1,RET
MOVEM 1,(P1)
HLLZ 1,DEFEXT ;Fetch default extension
MOVEM 1,1(P1)
SETZ 1,
IFE STANSW, < GETPPN 1, > ;STANFORD alias kiudge
IFN STANSW, < DSKPPN 1, > ;Default PPN is self
MOVEM 1,3(P1)
CAIE 0,"." ;Extension coming?
GO NOTEXT
CALL RDFIL1 ;Yes, read it
HLLZM 1,1(P1)
NOTEXT: CAIE 0,"[" ;PPN coming?
GO SKRET ;No, return
IFN STANSW, < CALL RDFIL1 ;Read project
CALL RJUST
HLLM 1,3(P1) > ;(Stanford likes it PPN's right justified)
IFE STANSW, < CALL(RDINT,[8],OPCODE) ;DEC likes octal
HRLM 1,3(P1) >
CAIE 0,","
GO NOTCOM ;Assume he wants same programmer area
IFN STANSW, < CALL RDFIL1 ;Read programmer
CALL RJUST ;(Stanford likes it PPN's right justified)
HLRM 1,3(P1) >
IFE STANSW, < CALL(RDINT,[8],OPCODE) ;DEC likes octal
HRRM 1,3(P1) >
NOTCOM: CAIE 0,"]" ;Don't worry if no ']'
GO SKRET
XCT OPCODE
MOVE 0,1
;Skip return
SKRET: AOS -1(P)
;Non-skip return
RET: MOVE 1,0
POPP P1
POP3J
.PLEVEL←←.PLEVEL+2 ;(Set stack level for subr)
;Read sixbit with appropriate break characters
RDFIL1: CALL(RDSIX,OPCODE,[FILBRK])
POP0J
;Right justify for Stanford PPN
IFN STANSW,
<RJUST: JUMPE 1,[ POP0J ]
RJUST2: TLNE 1,77
POP0J
LSH 1,-6
GO RJUST2 >
.PLEVEL←←.PLEVEL-2
; The break table, break on not A-Z,a-z or $%
FILBRK: BYTE (32) -1 (1) 0 (3) -1 ;<null> thru #
BYTE (2) 0 (10) -1 (10) 0 (6) -1 (1) -1 (7) 0 ;$ thru G
BYTE (19) 0 (5) -1 (1) -1 (11) 0 ;H thru k
BYTE (15) 0 (5) -1 (16) 0 ;l thru <bs>
SUBREND RDFILN
PRGEND
ENTRY WRFILN ↔ TITLE WRFILN ↔EXTERNAL WRSIX
.INSERT LIBRARY.TMP
IFE STANSW,< EXTERNAL WRINT >
;____________________________________________________________________
NSUBR WRFILN,FILBLK,OPCODE
ACCUMULATORS{P1,P2}
PUSHP P1
EXCH P2,FILBLK
MOVSI P1,(<POINT 6,(P2)>)
LOOP1: ILDB 1,P1
JUMPE 1,CONT1
ADDI 1,40
XCT OPCODE
CONT1: CAMN P1,[POINT 6,(P2),35]
GO [ HLLZ 1,1(P2)
JUMPN 1,[ MOVEI 1,"."
XCT OPCODE
GO .+1 ]
GO EXTDON ]
CAME P1,[POINT 6,1(P2),17]
GO LOOP1
EXTDON: SKIPN 3(P2)
GO PPNDON
MOVEI 1,"["
XCT OPCODE
IFN STANSW,<
MOVE P1,[POINT 6,3(P2)]
LOOP2: ILDB 1,P1
JUMPE 1,CONT2
ADDI 1,40
XCT OPCODE
CONT2: CAMN P1,[POINT 6,3(P2),17]
GO [ MOVEI 1,","
XCT OPCODE
GO LOOP2 ]
CAME P1,[POINT 6,3(P2),35]
GO LOOP2
>;IFN STANSW
IFE STANSW,<
HLRZ 0,3(P2)
CALL(WRINT,0,[8],OPCODE)
MOVEI 1,","
XCT OPCODE
HRRZ 0,3(P2)
CALL(WRINT,0,[8],OPCODE)
>;IFE STANSW
MOVEI 1,"]"
XCT OPCODE
PPNDON: EXCH P2,FILBLK
POPP P1
POP2J
SUBREND WRFILN
;____________________________________________________________________
PRGEND
ENTRY RDINT ↔ TITLE RDINT
.INSERT LIBRARY.TMP
;Subroutines RDINT,WRINT
;____________________________________________________________________
NSUBR RDINT,BASE,OPCODE
SETZ 0,
LOOP: XCT OPCODE
CAIL 1,"0"
CAILE 1,"9"
GO [ EXCH 0,1
POP2J ]
IMUL 0,BASE
ADDI 0,-60(1)
GO LOOP
SUBREND RDINT;17-DEC-73(BGB)
PRGEND
ENTRY WRINT ↔ TITLE WRINT
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR WRINT,INTEGER,BASE,OPCODE
; Convert integer into character stream, in specified base.
MOVE 1,INTEGER↔POPP -3(P) ;FETCH ARG AND MOVE RET. ADR.
POPP SAVOP
POPP SAVBAS
PUSH P,2
PUSH P,[RET]
L1: JUMPGE 1,L2 ;TEST FOR NEGATIVE NUMBER.
MOVM 2,1 ;PRINT MINUS SIGN.
MOVEI 1,"-"
XCT SAVOP
MOVE 1,2
L2: IDIV 1,SAVBAS↔HRLM 2,(P) ;MODULO TEN AND SAVE.
SKIPE 1↔PUSHJ P,L2 ;TEST FOR DONE.
HLRZ 1,(P)↔ADDI 1,60
XCT SAVOP ;RESTORE & PRINT.
POP0J
RET: POP P,2
POP0J
DECLARE{SAVBAS,SAVOP}
SUBREND WRINT;17-DEC-73(BGB)
;____________________________________________________________________
PRGEND
ENTRY WROCT ↔ TITLE WROCT
.INSERT LIBRARY.TMP
NSUBR WROCT,INTEGER,LEN,OPCODE
; Convert octal number into character stream, with length LEN
WROCT: PUSHP 1
PUSHP 2
PUSHP 3
MOVE 1,LEN
MOVNI 3,3
IMULM 1,3
MOVE 1,INTEGER
SETZ 2,
LSHC 1,(3)
MOVE 3,LEN
L1: SETZ 1,
LSHC 1,3
ADDI 1,"0"
XCT OPCODE
SOJG 3,L1
POPP 3
POPP 2
POPP 1
POP3J
SUBREND WROCT;24-MAR-75(TVR)
;____________________________________________________________________
PRGEND
ENTRY WREFLO,WRFFLO,WRFLO ↔ TITLE WRFLO
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR WREFLO,NUMBER,CONTRL,OPERATION
ACCUMULATORS{DECPT,DECEXP,CHRCNT}
;DECPT Number of characters remaining before decimal point
;DECEXP Exponent (Decimal)
;CHRCNT Total number of characters remaining
;
JSP 0,FLONRM ;SET UP AC'S AND NORMALIZE FOR BASE 10
.PLEVEL←←.PLEVEL+3 ;(Adjust stack pointer)
CAMG CHRCNT,DECEXP ;WILL IT FIT?
GO ELOST ;LOSES!
;Here, DECPT contains number of character AFTER decimal point
SKIPL DECEXP ;IF EXP≥0
SUBI DECPT,1(DECEXP) ; THEN SUBTRACT SPACE FOR FIXED PART + DEC. PT
HLRZ 1,CONTRL ;FETCH NUMBER OF DIGITS RIGHT OF DEC. PT.
CAILE DECPT,1(1) ;IS THERE MORE ROOM THAN SPECIFIED?
MOVEI DECPT,1(1) ; YES, USE SPECIFIED DECIMAL POINT
SUBM CHRCNT,DECPT ;SUBTRACT CHARACTER RIGHT OF DEC. PT.
;FROM CHAR. COUNT
CALL FLOUT ;TO GET COUNT LEFT OF DEC. PT. AND CALL OUTPUT ROUTINE
GO FLORET
;____________________________________________________________________
;+X.XXXE+YY
↑WRFFLO↑:JSP 0,FLONRM ;SET UP AC'S AND NORMALIZE FOR BASE 10
CALL FLONRM ;MAKE A DECIMAL EXPONENT AND NORMALIZE
ELOST: SKIPL NUMBER
GO [ MOVEI 1,"+" ;'+' FOR 'F' FORMAT
XCT OPCODE
SOJA CHRCNT,.+1 ]
SUBI CHRCNT,4 ;SUBTRACT SPACE FOR EXPONENT
JUMPLE CHRCNT,FLOST ;LOSE CASE
PUSHP DECEXP
MOVEI DECPT,1
MOVEI DECEXP,1
MOVNI 1,4 ;Hack WIDTH for a bad reason (to avold
ADDM 1,WIDTH ; extraneous '.' in width 6!)
CALL FLOUT ;OUTPUT MANTISSA
POPP DECEXP
MOVEI 1,"E"
XCT OPCODE
JUMPL DECEXP,[MOVN DECEXP,DECEXP ;OUTPUT EXPONENT
MOVEI 1,"-"
GO .+2]
MOVEI 1,"+"
XCT OPCODE
IDIVI DECEXP,=10
MOVEI 1,"0"(DECEXP)
XCT OPCODE
MOVEI 1,"0"(DECEXP+1)
XCT OPCODE
GO FLORET
FLOST: ADDI CHRCNT,4
MOVEI 1,"*"
FLOST1: SOJL CHRCNT,FLORET
XCT OPCODE
GO FLOST1
.PLEVEL←←.PLEVEL-3
;____________________________________________________________________
;NSUBR WRFLO,NUMBER,OPERATION
↑WRFLO↑:PUSH P,(P) ;COPY RETURN ADDRESS
MOVE 0,-2(P) ;REPLACE ORIGINAL WITH OPERATION
MOVEM 0,OPERATION
MOVEI 0,1+7+1+4 ;(SIGN+MANTISSA+DEC.PT.+EXPONENT)
MOVEM 0,CONTRL
JSP 0,FLONRM ;SET UP AC'S AND NORMALIZE FOR BASE 10
CAMLE DECEXP,[-4]
CAIL DECEXP,7
GO ELOST
JUMPE 0,[MOVEI 1,"0"
XCT OPCODE
GO FLORET]
PUSH P,[WRFLO2] ;FAKE RETURN ADDRESS!
ADDI DECEXP,1 ;MAKES LIFE EASIER
MOVEI DECPT,7 ;SO THAT DECIMAL POINT IS NOT PRINTED IF NO
;FRACTIONAL PART!
WRFLO3: JUMPG DECEXP,WRFLO4
MOVEI 1,"0"
XCT OPCODE
MOVEI 1,"."
XCT OPCODE
MOVEI 1,"0"
AOJLE DECEXP,.-2
SUBI DECEXP,1 ;SIGH...
WRFLO4: IDIVI 0,=10
SUBI DECPT,1
JUMPE 1,WRFLO4
GO .+2
WRFLO1: IDIVI 0,=10 ;CLASSIC RECURSIVE DECIMAL PRINTER
HRLM 1,(P) ;(LEFT HALF OF RETURN ADDRESS)
JUMPE 0,.+2
CALL WRFLO1
HLRZ 1,(P) ;FETCH CHARACTER FROM LEFT HALF OF RETURN ADDRESS
ADDI 1,"0" ;CONVERT TO DECIMAL FOR OUTPUT
XCT OPCODE
SUBI DECPT,1
SOJN DECEXP,CPOPJ ;RETURN (TO NEXT CHARACTER OR DRIVER) IF CHAR. LEFT OF DEC. PT. ≠ 0.
JUMPL DECPT,CPOPJ ;NO DECIMAL POINT IF NO FRACTIONAL PART!
MOVEI 1,"." ;OUTPUT DECIMAL POINT
XCT OPCODE
POPJ P,
WRFLO2: MOVEI 1,"0"
SOJL DECEXP,FLORET
XCT OPCODE
GO .-2
;____________________________________________________________________
; FLOATING POINT NORMALIZE (FOR BASE 10).
; Call with JSP 0,FLINIT
FLONRM: PUSHP DECPT ;SAVE AC'S
PUSHP DECEXP
PUSHP CHRCNT
PUSHP 0 ;SAVE RETURN ADDRESS
MOVE 0,OPERATION
MOVEM 0,OPCODE
MOVE 0,NUMBER ;SET UP AC WITH NUMBER TO BE PRINTED
HRRZ CHRCNT,CONTRL ;FETCH NUMBER OF CHARACTERS FOR OUTPUT
JUMPG 0,FLONR2 ;NEGATIVE NUMBER?
JUMPE 0,[SETZ DECEXP, ;TEST FOR ZERO
JRST FLONR0] ;SPECIAL CASE FOR ZERO
MOVNS 0 ;NEGATE NUMBER
MOVEI 1,"-" ;OUTPUT A "-"
FLONR1: XCT OPCODE
SUBI CHRCNT,1
FLONR2: MOVEI DECEXP,6 ;INIT. EXPONENT
TLNN 0,377000 ;IS IT FLOATING?
FSC 0,233 ;NO! FLOAT IT!
FLONR3: CAML 0,[999999.5] ;NORMALIZE
JRST FLONR4
FMPR 0,[10.0]
SOJA DECEXP,FLONR3
FLONR4: CAMGE 0,[9999999.5]
JRST .+3
FDVR 0,[10.0]
AOJA DECEXP,FLONR4
IFN STANSW,< FIX 0,232000 ;FIX TO 2*MANTISSA >
IFE STANSW,< MULI 0,400 ; Separate fraction and exponant
EXCH 0,1
ASH 0,-243(1)
>
ADDI 0,1 ;ROUND!
ASH 0,-1
FLONR0: HRRZ DECPT,CHRCNT ;ALSO INTO CHRCNT
MOVEM CHRCNT,WIDTH ;(REMEMBER FOR DECIMAL POINT)
POPJ P,
.PLEVEL←←.PLEVEL-1
;____________________________________________________________________
FLORET: POPP CHRCNT ;RESTORE AC'S
POPP DECEXP
POPP DECPT
POP3J
;____________________________________________________________________
;OUTPUT FLOATING POINT NUMBER IN SPECIFIED FORMAT
;DECPT Number of characters remaining before decimal point
;DECEXP Exponent (Decimal)
;CHRCNT Total number of characters remaining
FLOUT: MOVEI 1," " ;START WITH LEADING SPACES, UNTIL DEC. PT.
JUMPE DECPT,FLOUT0
ADDI DECEXP,1 ;THIS SAVES TIME LATER!
FLOUT1: CAMG DECPT,DECEXP ;LEADING SPACES/ZEROS?
GO FLOUT3 ;NO, START ACTUAL INFORMATION
SOJE DECPT,[ MOVEI 1,"0" ;IF CHARACTERS LEFT OF DEC. PT = 0,
XCT OPCODE ; PRINT "0."
SOJLE CHRCNT,CPOPJ ;CHECK IF DONE WITH FIELD
FLOUT0: MOVEI 1,"."
XCT OPCODE
MOVEI 1,"0" ;USE ZEROS FROM NOW ON
GO FLOUT2 ]
XCT OPCODE ;OUTPUT SPACE OR ZERO
FLOUT2: SOJLE CHRCNT,CPOPJ ;CHECK FOR END OF FIELD
GO FLOUT1 ;REPEAT UNTIL ACTUAL INFORMATION STARTS.
;START ACTUAL INFORMATION
FLOUT3: JUMPLE DECEXP,.+3 ;IS DEC. PT. TO BE INCLUDED IN COUNT?
CAME DECEXP,WIDTH
SUBI CHRCNT,1 ;YES, ACCOUNT FOR IT
CAIG CHRCNT,6 ;IF FEW CHARACTER USED, DIVIDE TO MAKE
IDIV DECTAB-1(CHRCNT) ;IT FIT IN FIELD
CALL FLOUT4
MOVEI 1,"0"
FLOUT5: SOJL CHRCNT,CPOPJ ;TRAILING ZEROS
XCT OPCODE
SOJE DECPT,[MOVEI 1,"."
CAME DECEXP,WIDTH ;SPECIAL CASE CHECK
XCT OPCODE
JUMPE CHRCNT,CPOPJ
GO FLOUT5-1]
GO FLOUT5
FLOUT4: IDIVI 0,=10 ;CLASSIC RECURSIVE DECIMAL PRINTER
HRLM 1,(P) ;(LEFT HALF OF RETURN ADDRESS)
SOJLE CHRCNT,.+3 ;END OF FIELD CHECK
JUMPE 0,.+2
CALL FLOUT4
HLRZ 1,(P) ;FETCH CHARACTER FROM LEFT HALF OF RETURN ADDRESS
ADDI 1,"0" ;CONVERT TO DECIMAL FOR OUTPUT
XCT OPCODE
SOJN DECPT,CPOPJ ;RETURN (TO NEXT CHARACTER OR DRIVER) IF CHAR. LEFT OF DEC. PT. ≠ 0.
MOVEI 1,"." ;OUTPUT DECIMAL POINT
CAME DECEXP,WIDTH ;AVOID DECIMAL POINT IF EXACTLY FITS IN FIELD
XCT OPCODE
CPOPJ: POPJ P,
;____________________________________________________________________
DECTAB: =1000000↔=100000↔=10000↔=1000↔=100↔=10
DECLARE{OPCODE,WIDTH}
SUBREND WREFLO
PRGEND
ENTRY RDSIX ↔ TITLE RDSIX
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR RDSIX,OPCODE,BRKTAB
; Read SIXBIT, where BRKTAB is address of 4 word bit table indicating what
; characters are terminators.
; If there are more than 6 characters, additional characters are ignored.
;
; Returns SIXBIT in 1
; Terminating character in 0.
ACCUMULATOR{T1,P1}
PUSHP T1 ;Save AC's we'll need
PUSHP P1
MOVSI P1,(<POINT 6,0>) ;Pointer to where SIXBIT will go
SETZ 0,
LOOP: XCT OPCODE ;Pick up a character
PUSHP 1
IDIVI 1,=36
ADD 1,BRKTAB
MOVE 1,(1)
LSH 1,(2)
JUMPL 1,RET ;1 means terminator
POP P,1
CAIGE 1,"a"
SUBI 1,40
CAME P1,[POINT 6,0,35] ;Check for more than 6 characters
IDPB 1,P1 ;Pack into word
GO LOOP
RET: MOVE 1,0 ;Get SIXBIT to return
POPP 0 ;Get back terminator
POPP P1 ;Restore saved AC's
POPP T1
POP2J
SUBREND RDSIX
PRGEND
ENTRY WRSIX ↔ TITLE WRSIX
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR WRSIX,SIX,OPCODE
; Convert sixbit word into character stream.
PUSHP 0
MOVEI 0,6
PUSHP SIXPTR
LOOP: ILDB 1,(P)
ADDI 1,40
XCT OPCODE
SOJG 0,LOOP
POPP 0
POPP 0
POP2J
SIXPTR: POINT 6,-1+SIX
SUBREND WRSIX;17-DEC-73(BGB)
PRGEND
ENTRY WRASCZ ↔ TITLE WRASCZ
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR WRASCZ,ASCIZSTRING,OPCODE
MOVE 1,OPCODE ;Special case check for TTY
CAMN 1,[OUTCHR 1]
GO [; OUTSTR @ASCIZSTRING ;OUTSTR is much better than OUTCHR
OUTSTR @-2(P) ;macro loses here!
POP2J ]
MOVE 1,ASCIZSTRING ;Check for a byte pointer
TLNN 1,777700
HRLI 1,(<POINT 7,0>)
PUSHP 1
LOOP: ILDB 1,(P)
JUMPE 1,[POP P,(P)
POP2J]
XCT OPCODE
JRST LOOP
SUBREND WRASCZ
;____________________________________________________________________
PRGEND
ENTRY WRSQUO ↔ TITLE CVSQUO
.INSERT LIBRARY.TMP
;____________________________________________________________________
NSUBR WRSQUO,SQUOZE,OPCODE
; Convert squoze (RADIX50) into character stream, in specified base.
MOVE 1,SQUOZE↔POPP -2(P) ;FETCH ARG AND MOVE RET. ADR.
TLZ 1,740000 ;CLEAR HIGH ORDER BITS
POPP SAVOP
PUSH P,2
PUSH P,[RET]
L1: IDIVI 1,50
ADDI 2,60-1 ;CONVERT
CAIGE 2,13+(60-1) ;LETTER?
JRST L2 ;NO
ADDI 2,101-13-(60-1) ;CONVERT
CAIG 2,132 ;FUNNY LETTER?
JRST L2 ;NO
MOVE 2,["."↔"$"↔"%"]-133(2)
L2: HRLM 2,(P) ;SAVE CHARACTER
SKIPE 1 ;TEST FOR DONE
PUSHJ P,L1 ;RECUR
HLRZ 1,(P)↔XCT SAVOP ;RESTORE & PRINT.
POP0J
RET: POP P,2
POP0J
DECLARE{SAVOP}
SUBREND WRSQUO;17-DEC-73(BGB)
;____________________________________________________________________
PRGEND
;ENTRY WRDATE,WRTIME,WRTIMT,WRDAYT↔ TITLE WRDATE
.INSERT LIBRARY.TMP
ENTRY WRDATE,WRTIME,WRTIMT
IFN STANSW,<ENTRY WRDAYT>
TITLE WRDATE
;____________________________________________________________________
NSUBR WRDATE,VAL,OP
CVDATE: PUSHP 0 ;Save some registers
PUSHP 1
PUSHP 2
MOVE 0,VAL ;Get date ((date-1964)*12+month-1)*31+day-1
IDIVI 0,=31 ;Extract day
ADDI 1,1 ;Months start on the first
PUSHJ P,OUT2DG ;Output day number
MOVEI 1,"-" ;Output seperator
XCT OP
IDIVI 0,=12 ;Get month number
MOVEI 2,MONNAM(1) ;Get name of month
HRLI 2,(<POINT 7,0>) ;Make into byte pointer
L1: ILDB 1,2 ;Output month name
JUMPN 1,[XCT OP ;One character at a time
JRST L1]
MOVE 1,0 ;Get year
ADDI 1,=64 ;Starting in 1964
PUSHJ P,OUT2DG ;Output two digits
POPP 2 ;Restore AC's
POPP 1
POPP 0
POP2J ;Flush arguments and return
IFN STANSW,<
;Output date & time (ACTTIM format)
WRDAYT↑:PUSHP 1 ;Save an AC
HLRZ 1,VAL ;Get date part
CALL WRDATE,1,OP
MOVEI 1," " ;Output separator
XCT OP
HRRZ 1,VAL ;Now, time part
CALL WRTIME,1,OP
POPP 1 ;Restore AC
POP2J ;Flush args and return
>;IFN STANSW
;Output time in seconds in seconds past midnight
WRTIME↑: PUSHP 1
PUSHP 2
MOVE 1,VAL ;Get time to output
WRTIM2: IDIVI 1,=60 ;Divide by number of seconds
IDIVI 1,=60 ;Divide by number of minutes
PUSHP 2 ;Save number of minutes
PUSHJ P,OUT2DG ;Output hours
MOVEI 1,":" ;Output seperator
XCT OP
MOVE 1,(P) ;Now do minutes
PUSHJ P,OUT2DG
POPP <(P)> ;Flush saved minutes
POPP 2 ;Restore registers
POPP 1
POP2J ;Flush arguments and return
;Output time given in tics
WRTIMT↑:PUSHP 1
PUSHP 2
MOVE 1,VAL
IDIVI 1,=60 ;Divide by number of tics
JRST WRTIM2
.PLEVEL←←.PLEVEL+2 ;Account for return address of stack
OUT2DG: IDIVI 1,=10 ;Seperate high and low order digits
ADDI 1,"0" ;Convert to ASCII
XCT OP ;and output high order digit
MOVEI 1,"0"(2) ;Convert low order digit to ASCII
XCT OP ;and output it
POPJ P,
MONNAM: ASCIZ/Jan-/
ASCIZ/Feb-/
ASCIZ/Mar-/
ASCIZ/Apr-/
ASCIZ/May-/
ASCIZ/Jun-/
ASCIZ/Jul-/
ASCIZ/Aug-/
ASCIZ/Sep-/
ASCIZ/Oct-/
ASCIZ/Nov-/
ASCIZ/Dec-/
SUBREND WRDATE
;____________________________________________________________________
PRGEND
ENTRY POP1J.,POP2J.,POP3J.,POP4J.↔ TITLE POPJS
.INSERT LIBRARY.TMP
;____________________________________________________________________
FOR @` I←1,4
<POP`I`J.: SUB P,[XWD I+1,I+1]↔JRST @I+1(P)
>
;____________________________________________________________________
END